COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00012 ENDMK
C⊗;
ENTRY;
BEGIN "INIT2"

DEFINE $INIT=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

DEFINE II=0;
DEFINE MAKEOP(OPNUM,OPNAM)"[]"=
	[ REDEFINE II = II + 2 ;
	DEFINE OPNUM = II ; ];

REQUIRE "INTOPS.SAI" SOURCE_FILE;
REQUIRE "MOVE.DEF[PNT,HE]" SOURCE_FILE;


PROCEDURE INISCANNER;
	BEGIN
	INTEGER I;		
	FOR I←#MIN STEP 1 UNTIL #MAX DO $ENTRY[I]←0;
	STOKEN←FALSE;
	$ALLOW←0;
	$TTYFL←NULL;
	$TOTFL←0;
	$ALFL←"DECLAR.AL";		! default name for input/output file;
	$EPS←0.001;

	DEVICE←TTY_X;	! input is from teletype;
	TTYUP(TRUE);	! all input from teletype to be converted to UPPER case;
	END;

PROCEDURE INIOFFSET;
BEGIN
	ALEVENTOFF←'400;
	ARROFF[#SC]←'401;
	ARROFF[#VT]←'402;
	ARROFF[#RT]←ARROFF[#TR]←ARROFF[#FR]←'403;
	$SYMOFF←'404;
END;

PROCEDURE TMPOFFSET;
BEGIN
	INTEGER ARRAY ARR[1:6];
	INTEGER I; ! make 9 new scalars because 10th is already made in AL;
	INTEGER INDEX;
	$TSCOFF←$SYMOFF;
	$TTROFF←$SYMOFF+10;
	$SYMOFF←$TTROFF+10;
	INDEX←0;
	FOR I←XMVAR,#SC,9,#RT,10,0 DO ARR[INDEX←INDEX+1]←I;
	$EXECUTE(αEXPR$(ARR,0));
END;

REQUIRE "⊂⊃⊂⊃" DELIMITERS;

REQUIRE "AIDEFS.SAI[AID,HE]" SOURCE_FILE;

PROCEDURE INIMAXOFFSET;
	BEGIN
	INTEGER I;
	ARRCLR(OFFSET);	! clear data array of offsets;
	OFFSET[MAX_OFFSET,#SC]←NO_OF_SCALARS;
	OFFSET[MAX_OFFSET,#VT]←NO_OF_VECTORS;
	OFFSET[MAX_OFFSET,#FR]←OFFSET[MAX_OFFSET,#TR]←
		OFFSET[MAX_OFFSET,#RT]←NO_OF_TRANSES;
	OFFSET[MAX_OFFSET,#MC]←NO_OF_MACROS;
	OFFSET[MAX_OFFSET,#FN]←NO_OF_FUNCTIONS;
	END;

REQUIRE UNSTACK_DELIMITERS;

PROCEDURE INIWORLD;
	BEGIN
	WORLD←ENSYM("STATION",#FR,F_WRLD←MK_REC(#FR));
	FRAME:PNAME[F_WRLD]←"STATION";
	END;

PROCEDURE SETOFFSET(INTEGER INDEX);
	BEGIN
	INTEGER I;
	IF INDEX≠CON_OFFSET AND INDEX≠PRG_OFFSET THEN OUTSTR("error in SETOFFSET")
	  ELSE FOR I←1 STEP 1 UNTIL 7 DO OFFSET[INDEX,I]←OFFSET[CUR_OFFSET,I];
	END;

PROCEDURE SAVRESOFFSET;
	BEGIN
	INTEGER I;
	FOR I←#MIN STEP 1 UNTIL #MAX DO OFFSET[RES_OFFSET,I]←$ENTRY[I];
	END;

PROCEDURE GTARMOFFSET;
	BEGIN
	INTEGER I,NILROTOFF,NILTRANSOFF;
	SYMBOL:OFFSET[HANDY←CHECK("YHAND",#SC)]←YHD_ALOFFSET;
	SYMBOL:INDEX[HANDY]←0;
	SYMBOL:OFFSET[HANDB←CHECK("BHAND",#SC)]←BHD_ALOFFSET;
	SYMBOL:INDEX[HANDB]←0;
	SYMBOL:OFFSET[YARM←CHECK("YARM",#FR)]←YRM_ALOFFSET;
	SYMBOL:INDEX[YARM]←0;
	SYMBOL:OFFSET[BARM←CHECK("BARM",#FR)]←BRM_ALOFFSET;
	SYMBOL:INDEX[BARM]←0;
	NILROTOFF←SYMBOL:INDEX[CHECK("NILROT",#RT)];
	NILTRANSOFF←SYMBOL:INDEX[CHECK("NILTRANS",#TR)];
	OFFSET[ARM_OFFSET,#SC]←OFFSET[CUR_OFFSET,#SC];
	OFFSET[ARM_OFFSET,#VT]←OFFSET[CUR_OFFSET,#VT];
	OFFSET[ARM_OFFSET,#RT]←NILROTOFF;
	OFFSET[ARM_OFFSET,#TR]←NILTRANSOFF;
	OFFSET[ARM_OFFSET,#FR]←OFFSET[CUR_OFFSET,#FR];
	END;


PROCEDURE ARMPCODE;
	BEGIN
	! to set up an array of pcode to update arm values;
	INTEGER ARRAY ARMREAD[1:8],MECH[1:3];
	INTEGER I,INDEX;
	INDEX←0;
	FOR I←XWHERE,BARM_MECH,
		XCHNGE,BRM_ALOFFSET,
	      XWHERE,BHAND_MECH,
		XCHNGE,BHD_ALOFFSET
		DO ARMREAD[INDEX←INDEX+1]←I;
	$ARMPCODE←αEXPR$(ARMREAD,0);
	INDEX←0;
	FOR I←XGTVAL,BRM_ALOFFSET,XRTVAL DO MECH[INDEX←INDEX+1]←I;
	$BRMUPDATE←αEXPR$(MECH,#FR);
	ADDTEN($BRMUPDATE,αTEN$(XXASSIGN,#FR,BARM));
	INDEX←0;
	FOR I←XGTVAL,BHD_ALOFFSET,XRTVAL DO MECH[INDEX←INDEX+1]←I;
	$BHDUPDATE←αEXPR$(MECH,#SC);
	ADDTEN($BHDUPDATE,αTEN$(XXASSIGN,#SC,HANDB));
	END;


PROCEDURE INIBRK;
BEGIN
STRING BTABLE;
BTABLE←":<>≤≥≡≠⊂⊃={}.,;[]()+-*/←↑↓→?α$|⊗"&LF&CR&TAB&FF&SP&dquote;
SETBREAK ($CRTAB ←GETBREAK,CR,LF&FF,"INSK");
SETBREAK ($FFTAB ←GETBREAK,FF,NULL,"INSK");
SETBREAK ($RETAB ←GETBREAK,BTABLE,NULL,"INR");		! used by gtoken;
SETBREAK ($SKTAB ←GETBREAK,BTABLE,NULL,"INS");
SETBREAK ($SPCTAB←GETBREAK,TAB&SP,NULL, "XNR");
SETBREAK ($ALFTAB←GETBREAK,NULL,NULL,"XRN");
SETBREAK ($NUMTAB←GETBREAK,"@+-0123456789",NULL,"XNR");	! as table 10;
SETBREAK ($DSHTAB←GETBREAK,"_",NULL,"INS");		! used by COPY/MERGE;
SETBREAK ($ERRTAB←GETBREAK,BTABLE,SP&CR,"IN");		! used while recovering;
SETBREAK ($BSKTAB←GETBREAK,NULL,SP,"IN");		! used to eliminate blanks;
SETBREAK ($DPYTAB←GETBREAK,CR,CRLF,"INS");		! used for display;
$BLANK←"                                        ";
SETFORMAT(0,3);
END;

PROCEDURE CONSTDATA;
	BEGIN
	! read in and set up temporary scalars;
	ASKUSER("SCALAR "&RUBOUT&"I1, "&RUBOUT&"I2,"&RUBOUT&"I3, "&RUBOUT&"I4, "
			&RUBOUT&"I5; ___ENDASKUSER
");
	GTOKEN;
	SETOFFSET(PRG_OFFSET);
	WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	! read in and set up constant data fields;
	READCODE("POINTY.INI[PNT,HE]");
	GTOKEN;
	WHILE NOT EQU(TOKEN,"_____END____INIT") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	$ALLOW←0;
	END;


PROCEDURE ARMPCODE0;
	BEGIN
	! to do no-ops for the armread during initialization;
	INTEGER ARRAY BUFF[1:1];
	BUFF[1]←XNOOP;
	$ARMPCODE←αEXPR$(BUFF,0);
	END;

DEFINE #USERS=11;
PRESET_WITH
	"TOB","ARG","MSM"," HN","JKS","ROD",
	"RDG"," NH"," ES","KFL","WRM";
STRING ARRAY USERID[1:#USERS];
PRESET_WITH
	"Tom","Ron","Shahid","Hamid","Ken","Rod",
	"Russell","Norm","Gene","Karl","Bill";
STRING ARRAY USERNAME[1:#USERS];

PROCEDURE GETUSERNAME;
BEGIN
	INTEGER I; STRING ID;
	ID←CVXSTR(CALL(0,"DSKPPN"));	! look at alias;
	ID←ID[4 TO 6];
	FOR I←1 STEP 1 UNTIL #USERS
		DO IF EQU(ID,USERID[I]) THEN DONE;
	IF I>#USERS THEN
		BEGIN
		ID←CVXSTR(CALL(0,"GETPPN"));	! look at login ppn;
		ID←ID[4 TO 6];
		FOR I←1 STEP 1 UNTIL #USERS
			DO IF EQU(ID,USERID[I]) THEN DONE;
		END;
	IF I>#USERS THEN BEGIN OUTSTR("I haven't met you before, what is your name?  ");
			$USERNAME←INCHWL;
			END
		ELSE $USERNAME←USERNAME[I];
END;

INTERNAL PROCEDURE INIT;
	BEGIN
	ALINIT;
	INISCANNER;	! initialize the scanner;
	INIMAXOFFSET;	! initialize the offset tables;
	INIOFFSET;	! initialize arroff,varoff,byvar;
			! dont change order of above two because inimaxoffset
				clears the array;
	INIBRK;		! initialize break tables;
	INIWORLD;
	ARMPCODE0;
	CONSTDATA;	! read in constant data;
	SETOFFSET(CON_OFFSET);
			! remember the current offsets;
	SAVRESOFFSET;
	GTARMOFFSET;	! keep offsets for arms;
	ARMPCODE;	! set up pcode array for reading arm positions;
	TMPOFFSET;	! set up temporary variables;
	GETUSERNAME;
	END;

REQUIRE INIT INITIALIZATION;

END;